!-------------------------------------------------------------LICENSE--------------------------------------------------------------!
!                                                                                                                                  !
!The MAP code is written in Fortran language for magnetohydrodynamics (MHD) calculation with the adaptive mesh refinement (AMR)    !
!and Message Passing Interface (MPI) parallelization.                                                                              !
!                                                                                                                                  !
!Copyright (C) 2012                                                                                                                !
!Ronglin Jiang                                                                                                                     !
!rljiang@ssc.net.cn                                                                                                                !
!585 Guoshoujing Road. Pudong, Shanghai, P.R.C. 201203                                                                             !
!                                                                                                                                  !
!This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License         !
!as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.             !
!                                                                                                                                  !
!This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of    !
!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.                        !
!                                                                                                                                  !
!You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software     !
!Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.                                                   !
!                                                                                                                                  !
!-------------------------------------------------------------LICENSE--------------------------------------------------------------!

!==================================================================================================================================|
subroutine block_exchange (current, dir, ro_flag, mx_flag, my_flag, mz_flag, bx_flag, by_flag, bz_flag, en_flag, az_flag, po_flag, &
   fix_flag)
!==================================================================================================================================|

   use parameters
   use block_define
   use interface_block_boundary_physi
   implicit none

   character(1), intent(in) :: dir
   logical(4), optional :: ro_flag, mx_flag, my_flag, mz_flag, bx_flag, by_flag, bz_flag, en_flag, az_flag, po_flag, fix_flag
   type(block), pointer, intent(in) :: current

   integer(4) :: i, j, level, i_n, i_c, j_n, j_c, i_neigh, j_neigh, i_neigh_x
   integer(4) :: nx_tmp, ny_tmp
   logical(4) :: fix_data_flag, data_exchange_flag

   type(block), pointer :: neigh, neigh_x, neigh_c

!----------------------------------------------------------------------------------------------------------------------------------|
   level = current%lv

   if (dir .eq. 'x') then
!----------------------------------------------------------------------------------------------------------------------------------|
!     left boundary
!----------------------------------------------------------------------------------------------------------------------------------|
      i_neigh = -1
      j_neigh = 0
      neigh => current%neigh(i_neigh, j_neigh)%pblock
      if (associated(neigh)) then
         if (neigh%lv .eq. level .and. neigh%cpu_id .eq. cpu_id) then
            nx_tmp = nx_no_bnd
            do i = 1, ng
               i_n = nx_tmp + i
               do j = 1, ny_no_bnd
                  j_n = j + ng
                  if (present(ro_flag)) current%ro(i, j_n) = neigh%ro(i_n, j_n)
                  if (present(mx_flag)) current%mx(i, j_n) = neigh%mx(i_n, j_n)
                  if (present(my_flag)) current%my(i, j_n) = neigh%my(i_n, j_n)
                  if (present(mz_flag)) current%mz(i, j_n) = neigh%mz(i_n, j_n)
                  if (present(bx_flag)) current%bx(i, j_n) = neigh%bx(i_n, j_n)
                  if (present(by_flag)) current%by(i, j_n) = neigh%by(i_n, j_n)
                  if (present(bz_flag)) current%bz(i, j_n) = neigh%bz(i_n, j_n)
                  if (present(en_flag)) current%en(i, j_n) = neigh%en(i_n, j_n)
                  if (present(az_flag)) current%az(i, j_n) = neigh%az(i_n, j_n)
                  if (present(po_flag)) current%po(i, j_n) = neigh%po(i_n, j_n)
               enddo
            enddo
         elseif (neigh%lv .lt. 0) then
            call block_boundary_physi (current, dir, 'l', 'i',                                                                     &
               present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                             &
               present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag), abs (neigh%lv))
         endif
      else
         call block_boundary_physi (current, dir, 'l', 'e',                                                                        &
            present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                                &
            present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag))
      endif

!----------------------------------------------------------------------------------------------------------------------------------|
!     right boundary
!----------------------------------------------------------------------------------------------------------------------------------|
      i_neigh = 1
      j_neigh = 0
      neigh => current%neigh(i_neigh, j_neigh)%pblock
      if (associated(neigh)) then
         if (neigh%lv .eq. level .and. neigh%cpu_id .eq. cpu_id) then
            nx_tmp = nx_block - ng
            do i = 1, ng
               i_c = nx_tmp + i
               i_n = ng + i
               do j = 1, ny_no_bnd
                  j_n = j + ng
                  if (present(ro_flag)) current%ro(i_c, j_n) = neigh%ro(i_n, j_n)
                  if (present(mx_flag)) current%mx(i_c, j_n) = neigh%mx(i_n, j_n)
                  if (present(my_flag)) current%my(i_c, j_n) = neigh%my(i_n, j_n)
                  if (present(mz_flag)) current%mz(i_c, j_n) = neigh%mz(i_n, j_n)
                  if (present(bx_flag)) current%bx(i_c, j_n) = neigh%bx(i_n, j_n)
                  if (present(by_flag)) current%by(i_c, j_n) = neigh%by(i_n, j_n)
                  if (present(bz_flag)) current%bz(i_c, j_n) = neigh%bz(i_n, j_n)
                  if (present(en_flag)) current%en(i_c, j_n) = neigh%en(i_n, j_n)
                  if (present(az_flag)) current%az(i_c, j_n) = neigh%az(i_n, j_n)
                  if (present(po_flag)) current%po(i_c, j_n) = neigh%po(i_n, j_n)
               enddo
            enddo
         elseif (neigh%lv .lt. 0) then
            call block_boundary_physi (current, dir, 'h', 'i',                                                                     &
               present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                             &
               present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag), abs (neigh%lv))
         endif
      else
         call block_boundary_physi (current, dir, 'h', 'e',                                                                        &
            present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                                &
            present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag))
      endif
   endif

   if (dir .eq. 'y') then
!----------------------------------------------------------------------------------------------------------------------------------|
!     bottom boundary
!----------------------------------------------------------------------------------------------------------------------------------|
      i_neigh = 0
      j_neigh = -1
      neigh => current%neigh(i_neigh, j_neigh)%pblock
      if (associated(neigh)) then
         if (neigh%lv .eq. level .and. neigh%cpu_id .eq. cpu_id) then

            data_exchange_flag = .true.
            if (present(fix_flag)) then
               fix_data_flag = .false.
               do i_neigh_x = -1, 1, 2
                  neigh_x => current%neigh(i_neigh_x, 0)%pblock
                  neigh_c => current%neigh(i_neigh_x, -1)%pblock
                  if (associated(neigh_x)) then
                     if (neigh_x%lv .eq. current%lv .and. neigh_c%lv .eq. current%lv - 1) fix_data_flag = .true.
                  endif
               enddo
               if (.not. fix_data_flag) data_exchange_flag = .false.
            endif

            if (data_exchange_flag) then
               ny_tmp = ny_no_bnd
               do j = 1, ng
                  j_n = ny_tmp + j
                  do i = 1, nx_block
                     if (present(ro_flag)) current%ro(i, j) = neigh%ro(i, j_n)
                     if (present(mx_flag)) current%mx(i, j) = neigh%mx(i, j_n)
                     if (present(my_flag)) current%my(i, j) = neigh%my(i, j_n)
                     if (present(mz_flag)) current%mz(i, j) = neigh%mz(i, j_n)
                     if (present(bx_flag)) current%bx(i, j) = neigh%bx(i, j_n)
                     if (present(by_flag)) current%by(i, j) = neigh%by(i, j_n)
                     if (present(bz_flag)) current%bz(i, j) = neigh%bz(i, j_n)
                     if (present(en_flag)) current%en(i, j) = neigh%en(i, j_n)
                     if (present(az_flag)) current%az(i, j) = neigh%az(i, j_n)
                     if (present(po_flag)) current%po(i, j) = neigh%po(i, j_n)
                  enddo
               enddo
            endif
         elseif (neigh%lv .lt. 0) then
            call block_boundary_physi (current, dir, 'l', 'i',                                                                     &
               present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                             &
               present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag), abs (neigh%lv))
         endif
      else
         call block_boundary_physi (current, dir, 'l', 'e',                                                                        &
            present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                                &
            present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag))
      endif

!----------------------------------------------------------------------------------------------------------------------------------|
!     top boundary
!----------------------------------------------------------------------------------------------------------------------------------|
      i_neigh = 0
      j_neigh = 1
      neigh => current%neigh(i_neigh, j_neigh)%pblock
      if (associated(neigh)) then
         if (neigh%lv .eq. level .and. neigh%cpu_id .eq. cpu_id) then

            data_exchange_flag = .true.
            if (present(fix_flag)) then
               fix_data_flag = .false.
               do i_neigh_x = -1, 1, 2
                  neigh_x => current%neigh(i_neigh_x, 0)%pblock
                  neigh_c => current%neigh(i_neigh_x, 1)%pblock
                  if (associated(neigh_x) .and. associated(neigh_c)) then
                     if (neigh_x%lv .eq. current%lv .and. neigh_c%lv .eq. current%lv - 1) fix_data_flag = .true.
                  endif
               enddo
               if (.not. fix_data_flag) data_exchange_flag = .false.
            endif

            if (data_exchange_flag) then
               ny_tmp = ny_block - ng
               do j = 1, ng
                  j_c = ny_tmp + j
                  j_n = ng + j
                  do i = 1, nx_block
                     if (present(ro_flag)) current%ro(i, j_c) = neigh%ro(i, j_n)
                     if (present(mx_flag)) current%mx(i, j_c) = neigh%mx(i, j_n)
                     if (present(my_flag)) current%my(i, j_c) = neigh%my(i, j_n)
                     if (present(mz_flag)) current%mz(i, j_c) = neigh%mz(i, j_n)
                     if (present(bx_flag)) current%bx(i, j_c) = neigh%bx(i, j_n)
                     if (present(by_flag)) current%by(i, j_c) = neigh%by(i, j_n)
                     if (present(bz_flag)) current%bz(i, j_c) = neigh%bz(i, j_n)
                     if (present(en_flag)) current%en(i, j_c) = neigh%en(i, j_n)
                     if (present(az_flag)) current%az(i, j_c) = neigh%az(i, j_n)
                     if (present(po_flag)) current%po(i, j_c) = neigh%po(i, j_n)
                  enddo
               enddo
            endif
         elseif (neigh%lv .lt. 0) then
            call block_boundary_physi (current, dir, 'h', 'i',                                                                     &
               present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                             &
               present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag), abs (neigh%lv))
         endif
      else
         call block_boundary_physi (current, dir, 'h', 'e',                                                                        &
            present(ro_flag), present(mx_flag), present(my_flag), present(mz_flag),                                                &
            present(bx_flag), present(by_flag), present(bz_flag), present(en_flag), present(po_flag))
      endif
   endif

!----------------------------------------------------------------------------------------------------------------------------------|
   return
end subroutine block_exchange
